perm filename READRW.F4[EMS,LCS] blob sn#722189 filedate 1983-08-02 generic text, type T, neo UTF8
C*****  CALLED BY EXPAND.F4 ********
C  READRW.F4
      SUBROUTINE READRW
      REAL LF
      INTEGER TOTL
	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT
1     CALL IO(1)
	SZF=1.
	CALL FACTORS
      CALL GETPTS(X,Y,Z,TOTL)
	IF(DDY.NE.0)RETURN
C RETURN IF DOING DRAWING TRANSITION.
C READ IN ALL THE POINTS
	CALL CENTER
C SET THE CENTER POINT -  CX,CY
      CALL SLOPES
	CALL PERCNT
C JTOTL=TOTAL # OF POINTS IN OUTER LINE OF DRAWING.
2     END

      SUBROUTINE RDOUTL
      INTEGER TOTL,TOTOUT
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT,TOTOUT
      COMMON /OUTL/OX(650),OY(650),OZ(650)
1     CALL IO(2)
      CALL OUTPTS(OX,OY,OZ,TOTOUT)
CC    CALL GETPTS(OX,OY,OZ,TOTOUT)
C READ IN OUTLINE POINTS
	END
 
      SUBROUTINE IO(N)
	COMMON/NM2/NM2
10    FORMAT(' TYPE DRAWING FILE NAME  '$)
11    FORMAT(' TYPE OUTLINE FILE NAME  '$)
13    FORMAT(' TYPE EXPAND FILE NAME  '$)
12    FORMAT(A5)
      GO TO(1,2,3)N
1     TYPE 10
      ACCEPT 12,NM
	IF(NM.EQ.' ')NM=NMX
	NMX=NM
      CALL IFILE(1,NM)
      RETURN
2	TYPE 11
      ACCEPT 12,NMB
	IF(NMB.EQ.' ')NMB=NMQ
	NMQ=NMB
      CALL IFILE(1,NMB)
      RETURN
3     TYPE 13
      ACCEPT 12,NM2
	IF(NM2.EQ.' ')RETURN
      CALL OFILE(20,NM2)
      END
 
      SUBROUTINE GETPTS(X,Y,Z,K)
      DIMENSION X(1),Y(1),Z(1)
 	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
1     FORMAT(1I,3F)
2     READ(1,1,END=99)K,A,B,Z(K)
	X(K)=(A+DDX)*SZF
	Y(K)=(B+DDY)*SZF
      GO TO 2
99    END

      SUBROUTINE OUTPTS(X,Y,Z,K)
      DIMENSION X(1),Y(1),Z(1)
 	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
1     FORMAT(1I,3F)
2     READ(1,1,END=99)K,A,B,Z(K)
	X(K)=A
	Y(K)=B
      GO TO 2
99	END

      SUBROUTINE CENTER
      INTEGER TOTL
      REAL LF
 	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT
      LF=X(1)
      RT=LF
      BOT=Y(1)
      TOP=BOT
      DO 1 K=2,TOTL
      A=X(K)
      IF(A.GT.RT)RT=A
      IF(A.LT.LF)LF=A
      A=Y(K)
      IF(A.GT.TOP)TOP=A
1     IF(A.LT.BOT)BOT=A
      CX=LF+(RT-LF)/2.+CCX
      CY=BOT+(TOP-BOT)/2.+CCY
CX AND CY ARE CENTER OF RECTANGLE (+DISPLACEMENT)
	M=CX*DSZ
	N=CY*DSZ
	CALL AIVECT(M,N)
	CALL AVECT(M,N)
	CALL DPYOUT(1)
      END
 
      SUBROUTINE SLOPES
      REAL LF
      INTEGER TOTL
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON /S/SL(650),P(650)
      COMMON TOTL,CX,CY,LF,RT,TOP,BOT
	D=0
      DO 1 K=1,TOTL
	A=RL(X(K),Y(K))
	IF(A.GT.D)D=A
C D=LONGEST LINE FROM POINT TO CENTER
	P(K)=A
C AT FIRST P HOLD LENGTH OF LINE FROM POINT TO CENTER.
      SL(K)=9999.
1     IF(CX.NE.X(K))SL(K)=(CY-Y(K))/(CX-X(K))
CC	DO 2 K=1,TOTL
CC2	P(K)=P(K)/D
C THIS CONVERTS P TO % OF LONGEST LINE. USED IN MAKNEW
      END
 

      FUNCTION RL(X,Y)
      INTEGER TOTL
      COMMON TOTL,CX,CY
C FIND HYPOTENUSE
      A=CX-X
      B=CY-Y
      RL=SQRT(A*A+B*B)
      END
 

	SUBROUTINE FACTORS
 	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF,DSZ
C G=DISTORTAION FACTOR, CCX,CCY=DISPLACEMENT OF CENTER
C DDX,DDY=DISPLACEMENT OF ENTIRE DRAWING, SZF=DRAWING SIZE FACTOR
1	FORMAT(' TYPE DISTORTION FACTOR (0=1) AND DPY SIZE (0=5)  '$)
2	FORMAT(' TYPE DRAWING CENTER DISPLACEMENT COORDS. '$)
3	FORMAT(' TYPE ENTIRE DRAWING DISPLACEMENT COORDS. '$)
4	FORMAT(' TYPE DRAWING SIZE FACTOR (CR=1.) '$)
14     FORMAT(' TYPE % OF TRANSITION  '$)
5	FORMAT(2F)
10	FORMAT(A1)
6	WRITE(5,1)
	READ(5,5)G,DSZ
	IF(G.EQ.0)G=1.0
	IF(DSZ.EQ.0)DSZ=5.
	REREAD 10,N
	IF(N.EQ.'B')GO TO 6
	IF(N.NE.'T')GO TO 7
	TYPE 14
	ACCEPT 5,CCX,CCY
C GET TRANSITION PERCENTAGES.
	IF(CCY.EQ.0)CCY=CCX
	DDY=1.
	RETURN
7	WRITE(5,2)
	READ(5,5)CCX,CCY
	REREAD 10,N
	IF(N.EQ.'B')GO TO 7
8	WRITE(5,3)
	READ(5,5)DDX,DDY
	REREAD 10,N
	IF(N.EQ.'B')GO TO 8
9	WRITE(5,4)
	READ(5,5)SZF
	IF(SZF.EQ.0)SZF=1.
	REREAD 10,N
	IF(N.EQ.'B')GO TO 9
	END

      SUBROUTINE PERCNT
      INTEGER TOTL,Q
	COMMON /CCC/G,CCX,CCY,DDX,DDY,SZF
      COMMON /XYZ/X(650),Y(650),Z(650)
      COMMON /S/SL(650),P(650)
      COMMON TOTL,CX,CY
      SQA=(TOP-CY)/(LF-CX)
      SQB=-SQA
C SLOPE OF DIAGONAL OF RECTANGLE
C ASSUMES FIRST CONTINUOUS LINE IS PICTURE OUTLINE
	P(1)=1.
	DO 100 K=2,TOTL
	IF(Z(K).NE.0)GO TO 101
	JTOTL=K
100	P(JTOTL)=1.
101	DO 200 K=JTOTL+1,TOTL
	J=2
202	IF(HIT(J,X,Y,K,A,B).EQ.0)GO TO 201
C A,B ARE COORDS OF HIT POINT.
	J=J+1
	GO TO 202

201   RLN=RL(X(K),Y(K))
C GET LENGTH OF LINE FROM CX,CY TO THIS POINT
      RLNB=RL(A,B)
8     H=RLN/RLNB
C H=% OF DIST. FROM CENTER TO OUTER LINE OF DRAWING.
200   P(K)=H
      END